home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / tspa3140.zip / TSUNTE.TST < prev    next >
Text File  |  1992-10-05  |  5KB  |  189 lines
  1. (* This is a test program for the TSUNTE.TPU unit 19-Aug-89,
  2.    Updated 24-Sep-89, 8-Oct-89, 4-Nov-89, 4-Dec-89, 17-Jul-90,
  3.            26-Aug-92, 5-Oct-92 *)
  4.  
  5. uses Dos, TSUNTE;
  6.  
  7. procedure LOGO;
  8. begin
  9.   writeln;
  10.   writeln ('TSUNTE unit test by Prof. Timo Salmi');
  11.   writeln ('University of Vaasa, Finland, ts@uwasa.fi');
  12.   writeln;
  13. end;  (* logo *)
  14.  
  15. (* Testing the cursor routines *)
  16. procedure TEST1;
  17. begin
  18.   CURSOFF;
  19.   writeln ('Cursor is off, press <═╝');
  20.   CLB;
  21.   readln;
  22.   CURSON;
  23.   writeln ('Cursor is on, press <═╝');
  24.   CLB;
  25.   readln;
  26.   CURSOR (0, 13);
  27.   writeln ('Cursor is big, press <═╝');
  28.   CLB;
  29.   readln;
  30.   CURSOR (6, 7);
  31.   writeln ('Cursor is normal, press <═╝');
  32.   CLB;
  33.   readln;
  34. end;  (* test1 *)
  35.  
  36. (* The most common system clock weekday *)
  37. procedure TEST2;
  38. const wkday : string[21] = 'SunMonTueWedThuFriSat';
  39. begin
  40.   writeln ('25-7-1980 was ', Copy (wkday, 3*WKDAYFN(25,7,1980)+1, 3));
  41.   writeln ('Week number ', WEEKNRFN (25,7,1980,false));
  42. end;  (* test2 *)
  43.  
  44. (* Special key status *)
  45. procedure TEST5;
  46. begin
  47.   if CAPSONFN then writeln ('CapsLock on') else writeln ('CapsLock off');
  48.   if NUMLONFN then writeln ('NumLock on') else writeln ('NumLock off');
  49.   if SCRLONFN then writeln ('ScrollLock on') else writeln ('ScrollLock off');
  50. end;  (* test5 *)
  51.  
  52. (* Existence and size of a file
  53.    IMPORTANT: Never apply on an open file! *)
  54. procedure TEST6;
  55. var fname : string;
  56. begin
  57.   fname := 'a:\command.com';          {Alter fname as appropriate}
  58.   if FEXISTFN (fname) then            {**************************}
  59.      begin
  60.        writeln ('File ', fname, ' size ', FSIZEFN(fname), ' bytes');
  61. {$IFNDEF VER40}
  62.        writeln ('The allocated size is ', ALLSIZFN(fname), ' bytes');
  63. {$ENDIF}
  64.      end
  65.    else
  66.      writeln ('File ', fname, ' does not exist');
  67. end;  (* test6 *)
  68.  
  69. (* Get the entire command line, spaces and all *)
  70. procedure TEST7;
  71. begin
  72.   writeln;
  73.   writeln ('Command line = ', CMDLNFN);
  74.   writeln;
  75. end;  (* test7 *)
  76.  
  77. (* Demonstrate keyboard status, observe your keyboard status leds *)
  78. procedure TEST8;
  79. const loop = 100000;  { adjust to your PC speed if necessary }
  80. var i, j : longint;
  81. begin
  82.   for j := 1 to 10 do
  83.     begin
  84.       CAPS (true);
  85.       NUMLOCK (false);
  86.       SCRLOCK (true);
  87.       if j = 1 then TEST5;
  88.       for i := 1 to loop do;
  89.       CAPS (false);
  90.       NUMLOCK (true);
  91.       SCRLOCK (false);
  92.       for i := 1 to loop do;
  93.     end;
  94.   TEST5;
  95. end;  (* test8 *)
  96.  
  97. (* The number of days in a given month and year *)
  98. procedure TEST9;
  99. var month, year : word;
  100. begin
  101.   month := 7;
  102.   year  := 1990;
  103.   writeln ('The last day of ', month, '-', year, ' is ',
  104.             LASTDMFN (month, year));
  105.   Flush (output);
  106.   month := 2;
  107.   year := 1988;
  108.   writeln ('The last day of ', month, '-', year, ' is ',
  109.             LASTDMFN (month, year));
  110.   Flush (output);
  111. end;  (* test9 *)
  112.  
  113. (* Test the validity of a date *)
  114. procedure TEST10;
  115. var day, month, year : word;
  116. begin
  117.   day   := 22;
  118.   month := 7;
  119.   year  := 1990;
  120.   write ('Date ', day, '-', month, '-', year);
  121.   if DATEOKFN (day, month, year) then
  122.      writeln (' is valid')
  123.    else
  124.      writeln (' is NOT valid');
  125. end;  (* test10 *)
  126.  
  127. (* Test which date is earlier *)
  128. procedure TEST11;
  129. var day, month, year                 : word;
  130.     daynow, monthnow, yearnow, dummy : word;
  131.     z, znow                          : real;
  132. begin
  133.   GetDate (yearnow, monthnow, daynow, dummy);
  134.   day   := 22;
  135.   month := 7;
  136.   year  := 1990;
  137.   write ('Date ', day, '-', month, '-', year);
  138.   z    := ZELLERFN (day, month, year);
  139.   znow := ZELLERFN (daynow, monthnow, yearnow);
  140.   if z = znow then
  141.      writeln (' is today')
  142.    else if z < znow then
  143.      writeln (' is earlier than today')
  144.    else
  145.      writeln (' is later than today');
  146. end;  (* test11 *)
  147.  
  148. {$IFNDEF VER40}  (* Not Turbo Pascal 4.0 *)
  149. (* Get the default drive and its label *)
  150. procedure TEST12;
  151. var drive : char;
  152. begin
  153.   drive := DEFDRVFN;
  154.   writeln ('Label on ', drive, ' is ', LABELFN (drive));
  155.   Flush (output);
  156. end;  (* test12 *)
  157. {$ENDIF}
  158.  
  159. (* Attributes of files *)
  160. procedure TEST13;
  161. const FileName = 'c:\msdos.sys';
  162. begin
  163.   writeln (FileName, ' is read-only = ', RDOFILFN (FileName));
  164.   Flush (output);
  165.   {}
  166.   writeln (FileName, ' is hidden = ', HIDFILFN (FileName));
  167.   Flush (output);
  168.   {}
  169.   writeln (FileName, ' is a system file = ', SYSFILFN (FileName));
  170.   Flush (output);
  171.   {}
  172.   writeln (FileName, ' arcvive bit on = ', ARCFILFN (FileName));
  173.   Flush (output);
  174. end;  (* test13 *)
  175.  
  176. (* Main program *)
  177. begin
  178.   LOGO;
  179.   BORDER(5);
  180.   {$IFNDEF VER40} TEST7; {$ENDIF}
  181.   TEST1;
  182.   TEST2;
  183.   TEST5;
  184.   TEST6;
  185.   write ('Press <═╝'); readln;
  186.   BORDER(0);
  187.   { If you want the rest of the test, insert the calls }
  188. end.  (* tsunte.tst *)
  189.